home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 031-040 / amok40 / koord / koord.mod < prev    next >
Text File  |  1993-11-04  |  5KB  |  171 lines
  1. (*
  2. ---------------------------------------------------------------------------
  3.   :Program.       Koord.mod
  4.   :Contents.      Mauskoordinaten des aktiven Windows mit Lupe.
  5.   :Author.        Franz Dimbeck
  6.   :Address.       Troppauerstraße 48, D-8058 Erding.
  7.   :Phone.         08122 18135
  8.   :Copyright.     Public Domain
  9.   :Language.      Oberon
  10.   :Translator.    Oberon V1.0 Demo-Version AMOK#36 Fridtjof Siebert
  11.   :History.       V1.0 Wednesday 27-Jun-90 21:20:29
  12. ---------------------------------------------------------------------------
  13. *)
  14.  
  15.  
  16. MODULE Koord;
  17.  
  18.  
  19. IMPORT I: Intuition,
  20.        G: Graphics,
  21.        E: Exec,
  22.        D: Dos,
  23.        S: SYSTEM;
  24.  
  25. (* $OvflChk- $RangeChk- $StackChk- $NilChk- $ReturnChk- $CaseChk- *)
  26.  
  27.  
  28. VAR
  29.   nx,            (* nx+1=Zahl der Punkte für Lupe in x-Richtung *)
  30.   ny,            (* ny+1=Zahl der Punkte für Lupe in y-Richtung *)
  31.   width,
  32.   height: INTEGER; (*Breite und Höhe des Fensters*)
  33.   KWin             : I.NewWindow;
  34.   MyWinPtr,
  35.   activeWinPtr     : I.WindowPtr;
  36.   firstScreenPtr,
  37.   oldScreenPtr     : I.ScreenPtr;
  38.   rPtr,SrPtr       : G.RastPortPtr;
  39.   intuiBasePtr     : I.IntuitionBasePtr;
  40.   MyMsg            : I.IntuiMessagePtr;
  41.   class            : LONGSET;
  42.   Str              : ARRAY 4 OF CHAR;
  43.   i                : LONGINT;
  44.   x,y,k,j,lx,ly    : INTEGER;
  45. PROCEDURE OpenWin;
  46. BEGIN
  47.   KWin.leftEdge  := 0;   ; KWin.topEdge := 0;
  48.   KWin.width     := width; KWin.height := height;
  49.   KWin.minWidth  := 71; KWin.minHeight := 20;
  50.   KWin.maxWidth  := -1; KWin.maxHeight := -1;
  51.   KWin.blockPen  := 3;
  52.   KWin.detailPen := 1;
  53.   KWin.idcmpFlags:= LONGSET{I.closeWindow,I.newSize};
  54.   KWin.flags     := LONGSET{I.windowDrag,
  55.                             I.windowSizing,
  56.                             I.windowClose,
  57.                             I.rmbTrap,
  58.                             I.noCareRefresh,
  59.                             I.activate};
  60.   KWin.title     := S.ADR("KOORD  -  © 1990 Franz Dimbeck  -PD- ");
  61.   KWin.screen    := firstScreenPtr ;
  62.   KWin.type      := I.customScreen  ;
  63.   MyWinPtr := I.OpenWindow(KWin);
  64.   IF MyWinPtr=NIL THEN HALT(0) END;
  65.   rPtr     := MyWinPtr.rPort;
  66.   I.SetWindowTitles
  67.     (MyWinPtr, -1 ,S.ADR("   KOORD  -  © 1990 Franz Dimbeck  -PD- "));
  68.   G.SetAPen(rPtr,3);
  69.   G.RectFill(rPtr,0,10, width,height);
  70.   G.SetAPen(rPtr,1);
  71.   G.RectFill(rPtr,31,33,38,40);
  72.  
  73. END OpenWin;
  74.  
  75. PROCEDURE CloseWin;
  76. BEGIN
  77.   IF MyWinPtr#NIL THEN I.CloseWindow(MyWinPtr) END;
  78.   MyWinPtr := NIL;
  79. END CloseWin;
  80.  
  81.  
  82. PROCEDURE ValToStr(i:INTEGER):LONGINT;
  83. BEGIN
  84.   Str[0] := "+";
  85.   IF i<0 THEN Str[0] := "-" ; i := -i END;
  86.   Str[1] := CHR((i DIV 100)+ORD("0"));
  87.   Str[2] := CHR(((i MOD 100) DIV 10)+ORD("0"));
  88.   Str[3] := CHR((i MOD 10) + ORD("0"));
  89.   RETURN S.ADR(Str);
  90. END ValToStr;
  91.  
  92.  
  93. PROCEDURE DoIt;
  94. BEGIN;
  95.   activeWinPtr := intuiBasePtr^.activeWindow;
  96.  
  97.   rPtr.fgPen := 0;
  98.   rPtr.bgPen := 1;
  99.   G.SetDrMd(rPtr,G.jam2);
  100.   G.Move(rPtr,3,17);
  101.   G.Text(rPtr,ValToStr(activeWinPtr.mouseX),4);
  102.   G.Move(rPtr,35,17);
  103.   G.Text(rPtr,ValToStr(activeWinPtr.mouseY),4);
  104.   x  := firstScreenPtr.mouseX;
  105.   y  := firstScreenPtr.mouseY;
  106.   IF ny>=0 THEN
  107.     j := y-ny DIV 2;  ly := 0;
  108.     LOOP
  109.       k := x-nx DIV 2; lx := 0;
  110.       LOOP
  111.         G.SetAPen(rPtr,SHORT(G.ReadPixel(SrPtr,k,j)));
  112.         G.RectFill(rPtr, 4+lx, 20+ly, 9+lx, 25+ly);
  113.         INC(lx,7);INC(k);
  114.         IF (lx>nx*7) THEN EXIT END;
  115.       END;
  116.       INC(ly,7);INC(j);
  117.       IF (ly>ny*7) THEN EXIT END;
  118.     END;
  119.   END; ;
  120.  
  121.   LOOP
  122.     INC(i);
  123.     IF x#firstScreenPtr.mouseX THEN EXIT END;
  124.     IF y#firstScreenPtr.mouseY THEN EXIT END;
  125.     D.Delay(5);
  126.     IF i > 20 THEN
  127.       I.WindowToFront(MyWinPtr);
  128.       i := 0
  129.     END;
  130.   END;
  131. END DoIt;
  132.  
  133.  
  134. (* -----------    M   A   I   N    --------------- *)
  135. BEGIN
  136.   i:=0;
  137.   nx:=8;
  138.   ny:=4;
  139.   width:= 70 ; height :=  56;
  140.  
  141.   intuiBasePtr := I.OpenIntuition();
  142.   MyWinPtr := NIL;
  143.   firstScreenPtr :=  intuiBasePtr^.firstScreen;
  144.   SrPtr := S.ADR(firstScreenPtr.rastPort);
  145.   OpenWin;
  146.   LOOP
  147.     DoIt;
  148.     MyMsg := E.GetMsg(MyWinPtr.userPort);
  149.     IF MyMsg # NIL THEN
  150.       class := MyMsg.class;
  151.       E.ReplyMsg(MyMsg);
  152.       IF (I.closeWindow IN class) THEN EXIT END;
  153.       IF (I.newSize  IN class) THEN
  154.         G.SetAPen(rPtr,3);
  155.         width:=MyWinPtr.width; height:=MyWinPtr.height;
  156.         G.RectFill(rPtr,0,10,width,height);
  157.         nx:=(width-5) DIV 7 -1;
  158.         ny:=(height-20) DIV 7 -1;
  159.         G.SetAPen(rPtr,1);
  160.         IF ny>=0 THEN
  161.           G.RectFill(rPtr,3+nx DIV 2*7,19+ny DIV 2*7,
  162.                   10+nx DIV 2*7,26+ny DIV 2*7);
  163.         END;
  164.       END;
  165.     END;
  166.   END;         (*      Trip away;                       *)
  167.   CloseWin;    (*      Make no stay;                    *)
  168. END Koord.     (*   Meet me at the break of day.        *)
  169.  
  170.  
  171.